home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / AutoRunner / AutoRunner.p < prev   
Encoding:
Text File  |  1997-05-06  |  11.7 KB  |  308 lines
  1. {AutoRunner is the creation of Jon Maxwell. It can be freely distributed,
  2.  following the rules written in the main documentation}
  3.  
  4. PROGRAM AutoRunner (Input,output);
  5. {Includes for PCQ Pascal, by Patrick Quaid}
  6. {$I "Include:Intuition/Intuition.i"}
  7. {$I "Include:Exec/Ports.i"}
  8. {$I "Include:Exec/Lists.i"}
  9. {$I "Include:Libraries/DOS.i"}
  10. {$I "Include:Utils/StringLib.i"}  {Includes for PCQ Pascal, by Patrick Quaid}
  11. {$I "Include:Utils/DOSUtils.i"}
  12. {$I "Include:Exec/Devices.i"}
  13. {$I "Include:Exec/IO.i"}
  14. {$I "Include:Exec/Tasks.i"}
  15. {$I "Include:Devices/Trackdisk.i"}
  16. CONST
  17. {Gadgets, obviously}
  18.   Gad5:Gadget=( nil,25,0,180,10,GADGHNONE,0,WDRAGGING,nil,nil,nil,0,nil,-1,nil);
  19.   Gad4Text:IntuiText=(1,0,JAM1,0,1,nil,"3",nil);
  20.   Gad4:Gadget=( nil,230,0,10,10,GADGHCOMP,GADGIMMEDIATE,BOOLGADGET,nil,nil,@Gad4Text,0,nil,3,nil);
  21.   Gad3Text:IntuiText=(1,0,JAM1,0,1,nil,"2",nil);
  22.   Gad3:Gadget=(@Gad4,220,0,10,10,GADGHCOMP,GADGIMMEDIATE,BOOLGADGET,nil,nil,@Gad3Text,0,nil,2,nil);
  23.   Gad2Text:IntuiText=(1,0,JAM1,0,1,nil,"1",nil);
  24.   Gad2:Gadget=(@Gad3,210,0,10,10,GADGHCOMP,GADGIMMEDIATE,BOOLGADGET,nil,nil,@Gad2Text,0,nil,1,nil);
  25.   Gad1Text:IntuiText=(1,0,JAM1,0,1,nil,"0",nil);
  26.   Gad1:Gadget=(@Gad2,200,0,10,10,GADGHCOMP,GADGIMMEDIATE,BOOLGADGET,nil,nil,@Gad1Text,0,nil,0,nil);
  27. VAR
  28.   TempAddr:Address;
  29.  
  30.   I:boolean;
  31.   Loop:Integer;
  32.   Wind:WindowPtr;
  33.   DiskValue:Array [0..3] OF Integer;  {Stores Old Disk ID so they won't be researched automatically}
  34. CONST
  35.   Unit2Check:Array [0..3] OF Boolean=(TRUE,TRUE,FALSE,FALSE); {Which drives should be checked, default}
  36.   OnlyOnce:Boolean=FALSE; {Check startup drives and then quit if True}
  37.   CDFlag:Boolean=TRUE;   {CD to inserted disk?}
  38.   StartCheck:Boolean=TRUE;{Check drives on startup?}
  39.   MaxUnit=3; {Largest unit number}
  40.   StdInName  : String = "CON:0/0/1/1/AutoRunnerCLI"; {1 Pixel CLI if no input/output}
  41.   StdOutName : String = StdInName;
  42.   AwakeStr="Auto Runner: Awake         ";
  43.   Sleeping="Auto Runner: Sleeping      ";
  44.   UnitNames:Array [0..3] Of String=("DF0:","DF1:","DF2:","DF3:");
  45. {----------------------}
  46. PROCEDURE MakeUnit2CheckList;
  47. VAR {reads passed param for units and flags}
  48.   Num,
  49.   Loop:Integer;
  50. BEGIN
  51.   FOR Loop:=0 TO 3 DO Unit2Check[Loop]:=FALSE;
  52.   FOR Loop:=0 TO strlen(CommandLine) DO BEGIN
  53.    CommandLine[Loop]:=ToUpper(CommandLine[Loop]);
  54.    Num:=ord(CommandLine[Loop])-ord('0');
  55.    IF (Num>-1) AND (Num<(MaxUnit+1)) THEN Unit2Check[Num]:=TRUE;
  56.    IF CommandLine[Loop]='C' THEN CDFlag:=FALSE;
  57.    IF CommandLine[Loop]='S' THEN StartCheck:=FALSE;
  58.    IF CommandLine[Loop]='O' THEN OnlyOnce:=TRUE;
  59.   END;
  60. END;
  61. {----------------------}
  62. PROCEDURE OpenTheWindow;
  63. {Old OpenTheWindow used WITH .. BEGIN to assign values to a NwPtr, but
  64.  that meant that the info must be in the program code anyway! This way,
  65.  using a Constant, it saves program space (around 260 bytes) and saves
  66.  time because everything is setup at compilation! }
  67. CONST
  68.   Nw:NewWindow=(0,10,300,10,1,0,MENUPICK_f+CLOSEWINDOW_f+GADGETDOWN_f+DISKINSERTED_f+ACTIVEWINDOW_f,WINDOWDEPTH+WINDOWCLOSE,nil,nil,AwakeStr,nil,nil,1,1,1023,1023,WBENCHSCREEN_f);
  69. BEGIN
  70.   Wind:=OpenWindow(@Nw);
  71.   IF Wind=nil THEN Exit(0);
  72. END;
  73. {----------------------}
  74. PROCEDURE LoadMenu (DriveNum:integer); {Loads and execute()'s the comments}
  75. VAR
  76.   I:Integer;
  77.   FL:FileLock;
  78.   OldDir:FileLock;  {In case you have CDFlag set, this stores the startup-dir}
  79.   FIB:FileInfoBlockPtr;
  80.   TempChar:Char;
  81.   NotDirEnd:Boolean; {Last item in the dir?}
  82.   OldCDFlag:Boolean; {Just stores default CD flag setting temporarily}
  83. TYPE
  84.   CommentBlock=RECORD {A Comment Block is New()ed when a comment is found--Dynamic allocation!}
  85.     NextBlock:^CommentBlock;
  86.     Comment:ARRAY [0..79] OF Char;
  87.     Flags:Integer;
  88.   END;
  89.   CommentPtr=^CommentBlock;
  90. VAR
  91.   TempComment:CommentPtr; {These three keep track of the Comments found}
  92.   Base:CommentPtr;
  93.   CurComment:CommentPtr;
  94. BEGIN
  95. {This is a mess, but it works...}
  96. {OUTLINE of this routine:
  97.   I.  Get root dir file lock
  98.   II. Look through all the Comments
  99.     A. Examine()
  100.     B. Autorunner Comment?
  101.         1. Allocate New CommentBlock
  102.         2. Fill in Current CommentBlock^.Next
  103.   III. Execute() Comments!
  104. }
  105.  
  106.   Base:=nil;
  107.   new(FIB); NotDirEnd:=TRUE;
  108.   FL:=Lock(UnitNames[DriveNum],SHARED_LOCK);
  109.   IF FL=nil THEN BEGIN writeln("Can't get a (shared) lock on ",UnitNames[DriveNum],"!"); Return; END;
  110.   IF NOT Examine(FL,FIB) THEN BEGIN unlock(FL); Dispose(FIB); Return; END;
  111.   REPEAT
  112.    IF (FIB^.fib_Comment[0]='¿') OR (FIB^.fib_Comment[0]='¡') THEN BEGIN
  113.     TempComment:=CurComment;
  114.     new(CurComment); IF Base=nil THEN Base:=CurComment;
  115.     TempComment^.NextBlock:=CurComment;
  116.     writeln(String(adr(FIB^.fib_Comment[1])));
  117.     FOR I:=0 TO 79 DO CurComment^.Comment[I]:=FIB^.fib_Comment[I];
  118.    END;
  119.    NotDirEnd:=ExNext(FL,FIB);
  120.   UNTIL NotDirEnd=FALSE;
  121.   CurComment:=Base;
  122.   IF CurComment<>nil THEN
  123.    REPEAT
  124.      OldCDFlag:=CDFlag;
  125.      IF CurComment^.Comment[0]='¡' THEN BEGIN
  126.       IF CurComment^.Comment[1]='C' THEN CDFlag:=TRUE;
  127.       IF CurComment^.Comment[1]='c' THEN CDFlag:=FALSE;
  128.      END;
  129.      IF CDFlag THEN OldDir:=CurrentDir(FL);
  130.      IF CurComment^.Comment[0]='¿' THEN IF Execute(String(@CurComment^.Comment[1]),FileHandle(nil),GetFileHandle(Output)) THEN;
  131.      IF CurComment^.Comment[0]='¡' THEN IF Execute(String(@CurComment^.Comment[2]),FileHandle(nil),GetFileHandle(Output)) THEN;
  132.      IF CDFlag=TRUE THEN FL:=CurrentDir(OldDir);
  133.      CDFlag:=OldCDFlag;
  134.      TempComment:=CurComment;
  135.      CurComment:=CurComment^.NextBlock;
  136.      dispose(TempComment);
  137.    UNTIL CurComment=nil;
  138.   CurComment:=nil; {PCQ Pascal will still try to Dispose() sometimes -> Guru}
  139.   UnLock(FL);
  140.   Dispose(FIB);
  141. END;
  142. {----------------------}
  143. FUNCTION DiskInDrive (UnitNum:Integer):Boolean;
  144. VAR
  145.  io:IOStdReqPtr;
  146.  MPort:MsgPortPtr; {for when trackdisk is done with the IO}
  147.  Error:Integer;
  148. BEGIN
  149.   new(io);
  150.   new(MPort);
  151.   newlist(adr(MPort^.mp_MsgList));
  152.   MPort^.mp_Flags:=PASignal;       { \               }
  153.   MPort^.mp_SigTask:=FindTask(nil);  {  =Sets up Message port}
  154.   MPort^.mp_SigBit:=1;           { /               }
  155.   io^.io_Message.mn_ReplyPort:=MPort;      { \sets up IO_messsage}
  156.   io^.io_Message.mn_Length:=sizeof(IOStdReq); { /structure with stuff}
  157.  
  158.   {Error is a placeholder after the opendevice check, becuase I don't test for errors after!}
  159.   Error:=OpenDevice("trackdisk.device",UnitNum,io,0);
  160.   IF Error<>0 THEN BEGIN writeln("Can't open unit: ",UnitNum); DiskInDrive:=FALSE; END;
  161.   io^.io_Command:=TD_CHANGESTATE;
  162.   Error:=DoIO(io);
  163.   Error:=WaitIO(io); {DoIO should wait, but perhaps it might mess up... :) }
  164.   Error:=io^.io_Actual; {Error now tells whether a disk is in the unit}
  165.   CloseDevice(io);
  166.   dispose(io);  { \releases memory-> less likely}
  167.   dispose(MPort); { /to fragment memory}
  168.   IF Error=0 THEN DiskInDrive:=TRUE;
  169.   DiskInDrive:=FALSE;
  170. END;
  171. {----------------------}
  172. FUNCTION VNode(FL:FileLock):integer;
  173. {Returns an ID for the disk}
  174. { (I know that there is something in the system to do this reliably,}
  175. { but I don't know how to find it yet) }
  176.  
  177. {PROBLEM: Simply takes the hash of the first two filenames -- I couldn't
  178.  figure out how to get the Disk ID, whereever or whatever that is, but
  179.  this works well enough... The Disk ID doesn't play a vital role anyway}
  180. VAR
  181.   VolNode:integer;
  182.   ID:InfoDataPtr;
  183.   FIB:FileInfoBlockPtr;
  184. BEGIN
  185.   new(ID);
  186.   new(FIB);
  187.   IF Examine(FL,FIB) THEN BEGIN
  188.     VolNode:=hash(string(adr(FIB^.fib_FileName[0])));
  189.     IF ExNext(FL,FIB) THEN VolNode:=VolNode+hash(string(adr(FIB^.fib_FileName[0])));
  190.     VNode:=VolNode;
  191.     END
  192.   ELSE
  193.     VNode:=0;
  194.   dispose(ID);
  195.   dispose(FIB);
  196. END;
  197. {----------------------}
  198. FUNCTION FindDiskInserted:Integer;
  199. {uses Disk IDs for the disks to find out which drive a disk was inserted in}
  200. VAR
  201.   FLock:FileLock;
  202.   Loop:Integer;
  203. BEGIN
  204.   FOR Loop:=0 TO MaxUnit DO
  205.   BEGIN
  206.    IF (Unit2Check[Loop]=TRUE) AND (DiskInDrive(Loop)) THEN BEGIN
  207.     FLock:=Lock(UnitNames[Loop],Access_Read);
  208.     IF FLock=nil THEN BEGIN Writeln("Bad Lock!"); FindDiskInserted:=-1; END;
  209.     IF (VNode(FLock)<>DiskValue[Loop]) THEN {Makes sure disk isn't last one that was in the unit}
  210.                       BEGIN
  211.                         DiskValue[Loop]:=VNode(FLock);
  212.                         UnLock(FLock);
  213.                         FindDiskInserted:=Loop;
  214.                       END;
  215.     UnLock(FLock);
  216.    END;
  217.   END;
  218.   FindDiskInserted:=-1; {-1 cancels further action}
  219. END;
  220. {----------------------}
  221. PROCEDURE GetDoMsg;
  222. {Monitors window IDCMP port for gadget & diskinserted messages, and calls
  223.  appropriate routines}
  224. VAR
  225.   Code,
  226.   Qualifier:Short;
  227.   MsgClass:Integer;
  228.   IM:IntuiMessagePtr;
  229.   Gad:GadgetPtr;
  230. BEGIN
  231.   WHILE 2=2 DO BEGIN
  232.    IM:=IntuiMessagePtr(WaitPort(Wind^.UserPort));
  233.    IM:=IntuiMessagePtr(GetMsg (Wind^.UserPort));
  234.    MsgClass:=IM^.Class;
  235.    Code:=IM^.Code;
  236.    Qualifier:=IM^.Qualifier;
  237.    Gad:=GadgetPtr(IM^.IAddress);
  238.    ReplyMsg(MessagePtr(IM));
  239.    IF (MsgClass=GADGETDOWN_f) OR (MsgClass=GADGETUP_f) THEN BEGIN
  240.     IF DiskInDrive(Gad^.GadgetID) THEN LoadMenu(Gad^.GadgetID);
  241.    END;
  242.    IF (MsgClass=ACTIVEWINDOW_f) THEN
  243.     RefreshGadgets(@Gad1,Wind,nil);
  244.    IF MsgClass=DISKINSERTED_f THEN BEGIN
  245.     Code:=FindDiskInserted;
  246.     IF Code>-1 THEN LoadMenu(Code);
  247.    END;
  248.    IF MsgClass=MENUPICK_f THEN BEGIN
  249.     SetWindowTitles(Wind,Sleeping,Sleeping);
  250.     RefreshGadgets(@Gad1,Wind,nil);
  251.     REPEAT
  252.       IM:=IntuiMessagePtr(WaitPort(Wind^.UserPort));
  253.       IM:=IntuiMessagePtr(GetMsg(Wind^.UserPort));
  254.       MsgClass:=IM^.Class;
  255.       ReplyMsg(MessagePtr(IM));
  256.     UNTIL MsgClass=MENUPICK_f;
  257.     SetWindowTitles(Wind,AwakeStr,AwakeStr);
  258.     RefreshGadgets(@Gad1,Wind,nil);
  259.    END;
  260.    IF MsgClass=CLOSEWINDOW_f THEN BEGIN
  261.     CloseWindow(Wind);
  262.     Exit(0);
  263.    END;
  264.   END;
  265. END;
  266. {----------------------}
  267. BEGIN
  268.   Unit2Check[0]:=TRUE;  { \           }
  269.   Unit2Check[1]:=TRUE;  { \ default drives  }
  270.   Unit2Check[2]:=FALSE; { /to be checked &  }
  271.   Unit2Check[3]:=FALSE; { /not to be checked }
  272.   IF strlen(CommandLine)>1 THEN {Checks for CLI Param}
  273.    IF CommandLine[0]='?' THEN BEGIN {TRUE=Print Below Info}
  274.                            writeln("AutoRunner is copyright (©) 1991 by Jonathan Maxwell");
  275.                            writeln("----------------------------------------------------");
  276.                            writeln("USAGE: AutoRunner ####sco, Where #### are the units  ");
  277.                            writeln("       to check and sco are the flags, in any order.");
  278.                            writeln("FLAGS: S=doesn't check drives when started");
  279.                            writeln("       C=doesn't auto-cd to inserted disk");
  280.                            writeln("       O=checks drives when started and then");
  281.                            writeln("         quits immediately");
  282.                            writeln("COMMENT SYNTAX:");
  283.                            writeln("       ¿command OR ¡<flag>command");
  284.                            writeln("       ¿=SHIFT ALT m (or ALT M)");
  285.                            writeln("       ¡=ALT i");
  286.                            writeln("       <flag>=C for forced CD (overrides command line)");
  287.                            writeln("       <flag>=c for forced NO-CD mode");
  288.                            Exit(0);
  289.                           END
  290.                         {FALSE=get units to check and flags}
  291.                       ELSE MakeUnit2CheckList;
  292.   IF OnlyOnce=FALSE THEN BEGIN
  293.    OpenTheWindow;
  294.    ClearMenuStrip(Wind); {Does this do anything here? I think not...}
  295.    Loop:=AddGList(Wind,@Gad1,1,4,nil); {Add the 4 device re-check gadgets}
  296.    Loop:=AddGadget(Wind,@Gad5,1);
  297.    RefreshGadgets(@Gad1,Wind,nil);{Make the gadgets visable}
  298.   END;
  299.   IF StartCheck=TRUE THEN {Following checks all set units unless flag was turned off}
  300.    FOR Loop:=0 TO MaxUnit DO BEGIN
  301.     IF Unit2Check[Loop]=TRUE THEN BEGIN
  302.       I:=DiskInDrive(Loop); {Makes sure a disk is in the drive (avoids "No disk in unit #" message) }
  303.       IF I THEN LoadMenu(Loop);
  304.     END;
  305.    END;
  306.   IF OnlyOnce=FALSE THEN GetDoMsg; {Main Control Center}
  307. END.
  308.